home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Serious Software / Cherwell Scientific Demos / pro Fit / pro Fit 5.0 demo (fpu).sea / pro Fit 5.0 demo (fpu) / Functions & Programs / Histogram < prev    next >
Text File  |  1996-04-15  |  4KB  |  128 lines
  1. { This program generates a histogram of a one-dimensional data set. }
  2. { The data set (which must be stored in a column of a data window) is }
  3. { first analyzed by counting the number of data points in each interval. }
  4. { Then, the number of data points is plotted as a function of the interval. }
  5. { To use the program, choose "Add to Menu" from the Misc menu to compile it }
  6. { Then open a data window (if none is open). Then run the program by choosing }
  7. { "Histogram" from the Misc menu. }
  8.  
  9. program Histogram;
  10.  
  11. const maxNrIntervals = 1000;
  12.  
  13. var window, col:integer;            { the window and the column we use }
  14.     intervalWidth: real;      { the width of an interval }
  15.     xMin, xMax: real;         { the graph range }
  16.     outputTo: integer;        { 1: new graph; 2: current graph; 3:new data window }
  17.     nrIntervals: integer;
  18.     values: array[1..maxNrIntervals];
  19.     maxValue: real;           { largest value in values }
  20.  
  21. procedure initialize;
  22.  { this routine is called once when the program is added to }
  23.  { pro Fit's menus }
  24. begin
  25.   window := 0;        { default: use frontmost data window }
  26.   col := 1;           {          and column 1 }
  27.   intervalWidth := 0.01;
  28.   xmin := -1;
  29.   xmax := 1;
  30.   outputTo := 1;
  31. end;
  32.  
  33. procedure GetUserChoice;
  34.  { ask the user what he/she wants }
  35. begin
  36.   Input('$WData window',window, '$CColumn', col,
  37.         'X min', xMin, 'X max', xMax,
  38.         'Interval width', intervalWidth,
  39.         '$Pnew graph;current graph;data window$Ouput to', outputTo);
  40.   if intervalWidth <= 0 then
  41.     begin
  42.       Alert('Interval width must be > 0');
  43.       Halt;
  44.     end;
  45.   if xMin >= xMax then
  46.     begin
  47.       Alert('X min must be smaller than X max');
  48.       Halt;
  49.     end;
  50.   nrIntervals := (xMax-xMin)/intervalWidth;
  51.   if nrIntervals > maxNrIntervals then
  52.     begin
  53.       Alert('Interval width too small - too many intervals');
  54.       Halt;
  55.     end;
  56. end;
  57.  
  58. procedure CalculateValues;
  59.  { fills up the array values[] }
  60.  var i, index;
  61. begin
  62.  
  63.   for i := 1 to nrIntervals do values[i] := 0;
  64.   for i := 1 to nrRows do
  65.     if DataOK(i, col) then        { if there is something in this cell }
  66.       begin
  67.         index := 1 + Round((data[i,col] - xMin)/intervalWidth-0.499999999);
  68.         if (index >= 1) and (index <= nrIntervals) then
  69.           values[index] := values[index]+1;
  70.       end;
  71.   maxValue := 0;
  72.   for i := 1 to nrIntervals do
  73.    if values[i] > maxValue then maxValue := values[i];
  74. end;
  75.  
  76. procedure Output;
  77.  { creates/draws the graph }
  78.  var i, y;
  79. begin
  80.   if outputTo = 3 then          { if output to data window }
  81.   begin
  82.     NewWindow(dataType);
  83.     SetDataSize(nrIntervals,10);
  84.     SetColumnName(1, 'interval center');
  85.     SetColumnName(2, 'counts');
  86.     for i := 1 to nrIntervals do
  87.     begin
  88.       data[i,1] := xMin + (i-0.5)*intervalWidth;
  89.       data[i,2] := values[i];
  90.     end;
  91.     Exit;
  92.   end;
  93.   if outputTo = 1 then          { if output to new graph }
  94.   begin
  95.     SetLineStyle(1,1);          { set standard line style, in case it was changed }
  96.     SetLineColor(0,0,0);    {black}
  97.     SetFillColor(65535,0,0); {pure red}
  98.     SetCurveFill(xAxis,1);
  99.     CreateNewGraph(xMin,xMax,0,maxValue+1,0,0);
  100.     SetGraphAttributes(plotBehindAxes+gridInFront);
  101.         end;
  102.  
  103.   OpenCurve('Histogram');
  104.   MoveTo(xMin,0);
  105.   for i := 1 to nrIntervals do
  106.   begin
  107.     y := values[i];
  108.     Line(0, y);
  109.     Line(intervalWidth, 0);
  110.     Line(0, -y);
  111.   end;
  112.   CloseCurve;
  113.   if outputTo = 1 then    {reset some values }
  114.   begin
  115.     SetCurveFill(xAxis,0);{reset to no filling}
  116.     SetFillColor(0,0,0); {black}
  117.                 SetFillPattern(0);
  118.   end;
  119.   writeln(nrIntervals);
  120. end;
  121.  
  122. begin
  123.   GetUserChoice;
  124.   SetCurrentWindow(window);
  125.   CalculateValues;
  126.   Output;
  127. end;
  128.